home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
CRS
/
crs54.d81
/
trans12c.lbr
/
TRANS-04.INC
< prev
next >
Wrap
Text File
|
2009-10-10
|
6KB
|
258 lines
procedure SetFATPointer(Loc,Val: integer);
var
I,R: integer;
begin
I:= ((Loc * 3) div 2) +1;
R:= (FAT[I] or (FAT[I+1] shl 8));
if odd(loc) then
R:= ((R and $F) or (Val shl 4))
else
R:= ((R and $F000) or (Val and $FFF));
FAT[I]:= (R and $FF);
FAT[I+1]:= ((R shr 8) and $FF);
end;
procedure WriteMS_DOS;
var
FileName: Str20;
UnAmbiguous: Str20;
ErrorCode: integer;
I: integer;
RecsPerCluster: integer;
Remaining: integer;
NRecs: integer;
FAT_Marker: integer;
LastMarker: integer;
procedure Get_Unambiguous;
begin
UnAmbiguous:= '';
for I:= 1 to NameSize do
if not (CPM_FCB.Name[I] = ' ') then
UnAmbiguous:= UnAmbiguous + CPM_FCB.Name[I];
UnAmbiguous:= UnAmbiguous + '.';
for I:= 1 to TypeSize do
if not (CPM_FCB.Extention = ' ') then
UnAmbiguous:= UnAmbiguous + CPM_FCB.Extention[I];
end;
function FirstFree(Start: integer): integer;
var
I: integer;
begin
I:= Start;
while (I < NClusters + 2) and (FATPointer(I) <> 0) do
I:= I + 1;
FirstFree:= I;
if (I = NClusters + 2) then BiosError:= true;
end;
procedure ReadCPMfileIntoBuffer;
begin
if (Remaining > DataBufferSize div 128) then
NRecs:= DataBufferSize div 128
else
NRecs:= Remaining;
fillchar(DataBuffer, DataBufferSize, 0);
BlockRead(InFile, DataBuffer[1], NRecs);
if DEBUG then
writeln('NRecs=', NRecs);
end;
procedure WriteMS_DOSfileFromBuffer;
begin
NumberOfClusters := NRecs div RecsPerCluster;
if ((NRecs mod RecsPerCluster) > 0) then
NumberOfClusters := NumberOfClusters + 1;
for I := 0 to NumberOfClusters - 1 do
begin
SetFATPointer(FAT_Marker,FirstFree(FAT_Marker + 1));
WriteCluster(FAT_Marker, I * RecsPerCluster * 128 + 1);
LastMarker:= FAT_Marker;
FAT_Marker:= FirstFree(FAT_Marker + 1);
end;
end;
procedure ReWriteMS_DOS(FN: NameAry; FT: TypeAry); {Open a new MS_DOS file}
var
ErrorCode: integer;
S: Str20;
begin
S:= '????????.???';
VolumeName:= False;
SubDirName:= False;
SearchFirstAll(S,ErrorCode);
while (ErrorCode <> MTDirectory)
and (ErrorCode <> EODirectory)
or VolumeName
or SubDirName do
SearchNextAll(S,ErrorCode);
if (ErrorCode = EODirectory) then
BiosError:= true
else
begin
DOS_FCB^.Name:= FN;
DOS_FCB^.Extention:= FT;
DOS_FCB^.Attribute:= $20; {changed from 0: for IBM-PC Clones}
for I:= 12 to 21 do DOS_FCB^.Rsrvd[I]:= 0;
DOS_FCB^.Time:= 0;
DOS_FCB^.Date:= 0;
FAT_Marker:= FirstFree(2);
DOS_FCB^.ClusterNo:= FAT_Marker;
end;
end;
procedure CloseMS_DOS(Size: integer); {Update Directory and FAT sectors}
{ Size is filesize / 128 }
var
Size2: integer;
begin
Size2:= hi(Size shr 1); { prevent overflow }
Size:= ((Size and $1FF) shl 7);
DOS_FCB^.FileSize[1]:= lo(Size);
DOS_FCB^.FileSize[2]:= hi(Size);
DOS_FCB^.FileSize[3]:= lo(Size2);
DOS_FCB^.FileSize[4]:= hi(Size2);
if (Size = 0) then
(* DOS_FCB^.Cluster:= $FFF *)
else
SetFATPointer(LastMarker,$FFF);
WriteSector(DirSector,DirTrack,addr(DirBuffer));
PutFAT;
end;
begin (* WriteMS_DOS *)
{bdos(RESETDSK);} {for safety}
repeat
ClrScr;
writeln;
writeln('File Transfer From CP/M to MS-DOS');
writeln;
write('File Name to Get From CP/M: ');
readln(Filename);
writeln;
Stop:= (pos(':',FileName) <> 0);
if Stop then
begin
write('DriveCode = ',CPM_DriveCh);
writeln(', Do Not Include In Name.');
Continue;
end;
until not Stop;
Stop:= false;
CheckWildcard(FileName);
BiosSelect(CPM_Drive, First);
SearchFileCPM(FileName,ErrorCode,First);
if (ErrorCode = EODirectory) then
write('File Not Found, ')
else
begin
Get_Unambiguous;
assign(InFile,UnAmbiguous);
reset(InFile);
Remaining := FileSize(InFile);
if DEBUG then
writeln('FileSize=', Remaining);
ReadCPMfileIntoBuffer;
IdentifyMS_DOS;
if (Identity = Unidentified) then
begin
BiosSelect(CPM_Drive, Next);
close(InFile);
end
else
begin
write('Transfering -');
RecsPerCluster:= RecordsPerSector * SecsPerCluster;
repeat
SearchFirst(Unambiguous,ErrorCode);
writeln;
write(CPM_DriveCh + ':',UnAmbiguous);
if (ErrorCode = FoundDir) then
begin
write(' Exists');
Stop := true;
end
else
begin
ReWriteMS_DOS(CPM_FCB.Name,CPM_FCB.Extention);
if DEBUG then
writeln;
Stop := Stop or Break;
if not BiosError and not Stop then
begin
WriteMS_DOSfileFromBuffer;
Stop := Stop or BiosError or Break;
Remaining := Remaining - NRecs;
while (Remaining > 0) and not Stop do
begin
BiosSelect(CPM_Drive, Next);
ReadCPMfileIntoBuffer;
BiosSelect(MS_DOS_Drive, Next);
WriteMS_DOSfileFromBuffer;
Stop:= BiosError or Stop or Break;
Remaining:= Remaining - NRecs;
end; (* while *)
if not Stop then
CloseMS_DOS(FileSize(InFile));
end; (* if not bioserror *)
end; (* if founddir *)
BiosSelect(CPM_Drive,Next);
close(InFile);
Stop := Stop or Break;
if BiosError then
begin
Stop:= true;
writeln;
writeln('MS-DOS Write Error or Disk or Directory Full');
end
else
if WildCard and not Stop then
begin
SearchFileCPM(UnAmbiguous,ErrorCode,First);
SearchFileCPM(FileName,ErrorCode,Next);
if (ErrorCode = FoundDir) then
begin
Get_Unambiguous;
assign(InFile,UnAmbiguous);
reset(InFile);
Remaining := FileSize(InFile);
if DEBUG then
writeln('FileSize=', Remaining);
ReadCPMfileIntoBuffer;
BiosSelect(MS_DOS_Drive,Next);
end;
end;
until (ErrorCode = EODirectory) or Stop or not WildCard;
writeln;
writeln;
end; (* if not Identity *)
end; (* if EODirectory *)
if Stop then
write('Aborted, ');
Continue;
end; (* WriteMS_DOS *)